perm filename MAPFNS.CNV[C,JRA] blob sn#013564 filedate 1972-11-21 generic text, type T, neo UTF8

(DEFPROP CERR 
 (LAMBDA(L A)
  (PROG NIL
	(PRINT (QUOTE **ERROR**))
	(MAPC (QUOTE
	       (LAMBDA(X)
		(PROG NIL
		      (CPRIN1 (COND ((ATOM X) X) ((EQ (CAR X) (QUOTE @)) (EVAL (CDR X) A)) (T X)))
		      (RETURN (PRINC (QUOTE / ))))))
 	      L)
	(CPRINT EXP)
	(RETURN
	 (PROG NIL
	       (PRINT (QUOTE IN-LISP))
 	  LP   (PRINC (QUOTE *))
	       (ERRSET
		(COND ((EQ (SETQ ** (READ)) (QUOTE $P)) (RETURN NIL))
		      ((EQ (CAR **) (QUOTE RETURN)) (RETURN (EVAL (CADR **) A)))
		      (T (SETQ * (CPRINT (EVAL ** A))))))
	       (SETQ ← **)
	       (GO LP))))) 
FEXPR)

(DEFPROP FETCHI1 
 (LAMBDA(PATTERN CON)
  (PROG (ALISTS)
	(RETURN
	 (MAPCAN (QUOTE
		  (LAMBDA(ITEM)
		   (COND
		    ((SETQ ALISTS (MATCH PATTERN (CAR ITEM))) (LIST (LIST (QUOTE *ITEM) ITEM (CAR ALISTS)))))))
		 (SEARCH *ITEMS PATTERN T (CDR CON)))))) 
EXPR)

(DEFPROP FETCHM1 
 (LAMBDA(PATTERN INDEX CON)
  (MAPCAN (QUOTE
	   (LAMBDA(METHOD)
	    ((LAMBDA(MRESULT)
	      (COND (MRESULT (LIST (CONS (QUOTE *METHOD) (CONS METHOD (NCONC MRESULT (LIST PATTERN))))))))
	     (MATCH (PATTERN METHOD) PATTERN))))
	  (SEARCH INDEX PATTERN NIL (CDR CON)))) 
EXPR)

(DEFPROP SEARCH 
 (LAMBDA(INDEX PATTERN ITEM CON)
  (MAPCAN (QUOTE (LAMBDA (THING) (COND ((REALITY1 (CDR (CMARKERS THING)) CON) (LIST THING)))))
	  (ISEARCH INDEX PATTERN ITEM))) 
EXPR)

(DEFPROP INDEX 
 (LAMBDA(THING PATTERN INDEX)
  (PROG (NUM THINGS PFORM)
	(COND ((NULL INDEX) (BREAK BAD-INDEX--INDEX T))
	      ((EQ (CAR INDEX) (QUOTE *LIST))
	       (COND ((EQUAL (SETQ NUM (ADD1 (CADDR INDEX))) *INDEXTHRESHOLD) (RPLACA INDEX (QUOTE *INDEX))
									      (SETQ THINGS (CDDDR INDEX))
									      (SETQ PFORM (CADR INDEX))
									      (RPLACD
									       (CDR INDEX)
									       (LIST (LIST NIL) NIL))
									      (MAPC (!" LAMBDA
											(THING)
											(INDEX
											 THING
											 (@ . PFORM)
											 INDEX))
 										    THINGS))
		     (T (RPLACD (CDR INDEX) (CONS NUM (CONS THING (CDDDR INDEX)))) (RETURN THING))))
	      ((EQ (CAR INDEX) (QUOTE *INDEX)) (SETQ PFORM (CADR INDEX)))
	      ((BREAK BAD-INDEX--INDEX T)))
	(INDEX1 THING (CAR PATTERN) (CADDR INDEX) (QUOTE CAR) PFORM)
	(AND (CDR PATTERN) (INDEX1 THING (CDR PATTERN) (CDDDR INDEX) (QUOTE CDR) PFORM))
	(RETURN THING))) 
EXPR)

(DEFPROP PROPOSE 
 (LAMBDA(L)
  (PROG NIL
	(SETQ L (CDR (VLOC (QUOTE NEXT))))
	(RETURN
	 (MAPC (QUOTE (LAMBDA (X) (PROG NIL (RPLACD (CAR L) (CONS X (CDAR L))) (RETURN (RPLACA L (CDAR L))))))
	       (/, L))))) 
FEXPR)